home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / public / GNU / emacs.inst / emacs19.idb / usr / gnu / lib / emacs / site-lisp / xb-mouse.el.z / xb-mouse.el
Encoding:
Text File  |  1994-08-02  |  10.0 KB  |  261 lines
  1. ;;; xb-mouse.el: Functions to give emacs a more "X-behaved" mouse
  2. ;;; Copyright (C) 1993 by Thomas Crook (tcrook@u.cc.utah.edu)
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 2 of the License, or
  7. ;;; (at your option) any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13.  
  14.  
  15. ;;; Last Update: Wed Sep  8 12:53:13 1993 by tcrook@odo  
  16. ;;;
  17. ;;; Description: This package provides X inter-client copy and paste for
  18. ;;;              Emacs 19.19.  It works simalarly to Xterm, providing
  19. ;;;              word selection on double clicks and line selection on
  20. ;;;              triple clicks.  
  21. ;;;
  22. ;;; Disclaimer:  This was a very fast hack and almost certainly needs
  23. ;;;              improvements.  However, the original author, Thomas Crook,
  24. ;;;              is giving up his computer engineering career to pursue 
  25. ;;;              a PhD in marketing.  He will not be providing updates or
  26. ;;;              bug fixes.  If people find this useful, it is the
  27. ;;;              author's hope that some kind soul would adopt these
  28. ;;;              orphaned functions and provide support for them.
  29. ;;;
  30. ;;; Needed       Pasting from other X clients is known to be slow from
  31. ;;; Improvement: some machines, including SGI and HP PA-RISC.  This may
  32. ;;;              be due to a bug in Emacs itself.
  33. ;;;
  34. ;;; Acknowledgements:   mouse-set-point: 
  35. ;;;                            Hacked version of Gnu original
  36. ;;;                     local-mouse-drag-region: 
  37. ;;;                             Hacked version of Glenn Coombs' hack 
  38. ;;;                             of the Gnu original.
  39. ;;;                     Better behaved kill and yank stuff:
  40. ;;;                             Glenn Coombs,
  41. ;;;                             Phillips Research Labs,
  42. ;;;                             Redhill,
  43. ;;;                             ENGLAND
  44. ;;;                             (glenn@prl.philips.co.uk)
  45.  
  46.  
  47. (setq interprogram-cut-function nil)
  48. (setq interprogram-paste-function nil)
  49.  
  50. ;;; Uncomment this if you want insertions to occur at the mouse pointer
  51. (define-key  global-map  [mouse-2]      'local-insert-x-selection-at-pointer)
  52. ;;; Uncomment this if you want insertions to occur at the point
  53. ;(define-key  global-map  [mouse-2]      'local-insert-x-selection-at-point)
  54.  
  55. (define-key  global-map  [down-mouse-1] 'local-mouse-drag-region)
  56. (define-key  global-map  [mouse-3]    'local-mouse-save-then-kill)
  57.  
  58. (defun local-insert-x-selection-at-pointer (event)
  59.   "Sets the point to the mouse position and inserts the X selection
  60. to that point"
  61.   (interactive "e")
  62.   (let* ((posn (event-start event)))
  63.     (and (window-minibuffer-p (posn-window posn))
  64.      (not (minibuffer-window-active-p (posn-window posn)))
  65.      (error "Minibuffer window is not active"))
  66.     (select-window (posn-window posn))
  67.     (if (numberp (posn-point posn))
  68.     (progn
  69.       (goto-char (posn-point posn))
  70.       (insert (x-selection))))))
  71.  
  72. (defun local-insert-x-selection-at-point ()
  73.   "Pastes the X selection to wherever the point is"
  74.   (interactive)
  75.   (insert (x-selection)))
  76.  
  77. (defun double-click-word-select ()
  78.   "Select the word containing the point"
  79.   (interactive)
  80.   (forward-word 1)
  81.   (backward-char 1)
  82.   (mark-word 1)
  83.   (forward-word -1)
  84.   (x-set-cut-buffer (buffer-substring (point) (mark)))
  85.   (x-set-selection 'PRIMARY (buffer-substring (point) (mark))))
  86.  
  87. (defun triple-click-line-select ()
  88.   "Select the line containing the point"
  89.   (interactive)
  90.   (end-of-line)
  91.   (push-mark)
  92.   (beginning-of-line)
  93.   (x-set-cut-buffer (buffer-substring (point) (mark)))
  94.   (x-set-selection 'PRIMARY (buffer-substring (point) (mark))))
  95.  
  96. ;; Modified version of the Gnu original
  97. (defun mouse-set-point (event)
  98.   "Move point to the position clicked on with the mouse.
  99. This should be bound to a mouse click event type."
  100.   (interactive "e")
  101.   ;; Use event-end in case called from mouse-drag-region.
  102.   ;; If EVENT is a click, event-end and event-start give same value.
  103.   (let* ((posn (event-end event))
  104.      (clicks (event-click-count event)))
  105.     (and (window-minibuffer-p (posn-window posn))
  106.      (not (minibuffer-window-active-p (posn-window posn)))
  107.      (error "Minibuffer window is not active"))
  108.     (select-window (posn-window posn))
  109.     (if (and (= clicks 1)
  110.          (numberp (posn-point posn)))
  111.     (goto-char (posn-point posn)))))
  112.  
  113.  
  114. ;;;   Coombs:
  115. ;;;     This is taken straight out of mouse.el.  I have just added
  116. ;;;     two lines at the bottom to add the selected text to the cut
  117. ;;;     buffer and the primary selection.
  118. ;;;   Crook:
  119. ;;;     Added code to detect double and triple clicks and call
  120. ;;;     double and triple click selection functions.
  121. (defun local-mouse-drag-region (start-event)
  122.   "Set the region to the text that the mouse is dragged over.
  123. Highlight the drag area as you move the mouse.
  124. This must be bound to a button-down mouse event.
  125. In Transient Mark mode, the highlighting remains once you
  126. release the mouse button.  Otherwise, it does not."
  127.   (interactive "e")
  128.   (let* ((start-posn (event-start start-event))
  129.          (start-point (posn-point start-posn))
  130.          (start-window (posn-window start-posn))
  131.          (start-frame (window-frame start-window))
  132.          (bounds (window-edges start-window))
  133.          (top (nth 1 bounds))
  134.          (bottom (if (window-minibuffer-p start-window)
  135.                      (nth 3 bounds)
  136.                    ;; Don't count the mode line.
  137.                    (1- (nth 3 bounds))))
  138.      (clicks (event-click-count start-event)))
  139.     (if (= clicks 3)
  140.     (triple-click-line-select)
  141.       (if (= clicks 2)
  142.       (double-click-word-select)
  143.     (progn
  144.       (mouse-set-point start-event)
  145.       (move-overlay mouse-drag-overlay
  146.             start-point start-point
  147.             (window-buffer start-window))
  148.       (deactivate-mark)
  149.       (let (event end end-point)
  150.         (track-mouse
  151.           (while (progn
  152.                (setq event (read-event))
  153.                (or (mouse-movement-p event)
  154.                (eq (car-safe event) 'switch-frame)))
  155.         
  156.         (if (eq (car-safe event) 'switch-frame)
  157.             nil
  158.           (setq end (event-end event)
  159.             end-point (posn-point end))
  160.           
  161.           (cond
  162.            
  163.            ;; Ignore switch-frame events.
  164.            ((eq (car-safe event) 'switch-frame))
  165.            
  166.            ;; Are we moving within the original window?
  167.            ((and (eq (posn-window end) start-window)
  168.              (integer-or-marker-p end-point))
  169.             (goto-char end-point)
  170.             (move-overlay mouse-drag-overlay
  171.                   start-point (point)))
  172.            
  173.            ;; Are we moving on a different window on the same frame?
  174.            ((and (windowp (posn-window end))
  175.              (eq (window-frame (posn-window end)) start-frame))
  176.             (let ((mouse-row
  177.                (+ (nth 1 (window-edges (posn-window end)))
  178.                   (cdr (posn-col-row end)))))
  179.               (cond
  180.                ((< mouse-row top)
  181.             (mouse-scroll-subr
  182.              (- mouse-row top) mouse-drag-overlay start-point))
  183.                ((and (not (eobp))
  184.                  (>= mouse-row bottom))
  185.             (mouse-scroll-subr (1+ (- mouse-row bottom))
  186.                        mouse-drag-overlay start-point)))))
  187.            
  188.            (t
  189.             (let ((mouse-y (cdr (cdr (mouse-position))))
  190.               (menu-bar-lines (or (cdr (assq 'menu-bar-lines
  191.                              (frame-parameters)))
  192.                           0)))
  193.               
  194.               ;; Are we on the menu bar?
  195.               (and (integerp mouse-y) (< mouse-y menu-bar-lines)
  196.                (mouse-scroll-subr (- mouse-y menu-bar-lines)
  197.                           mouse-drag-overlay start-point))))))))
  198.         
  199.         (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
  200.              (eq (posn-window (event-end event)) start-window)
  201.              (numberp (posn-point (event-end event))))
  202.         (progn
  203.           (mouse-set-point event)
  204.           (if (= (point) start-point)
  205.               (deactivate-mark)
  206.             (set-mark start-point)
  207.             (x-set-cut-buffer (buffer-substring (point) (mark)))
  208.             (x-set-selection 'PRIMARY (buffer-substring (point) (mark))))))
  209.         (delete-overlay mouse-drag-overlay)))))))
  210.  
  211.  
  212.  
  213. ;;; Crook: This is a modification of the Gnu original.
  214. ;;;        I just added x-set-cut-buffer and x-set-selection calls
  215. ;;;        as in function local-mouse-drag-region above
  216. (defun local-mouse-save-then-kill (click)
  217.   "Save text to point in kill ring; the second time, kill the text.
  218. If the text between point and the mouse is the same as what's
  219. at the front of the kill ring, this deletes the text.
  220. Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
  221. which prepares for a second click to delete the text."
  222.   (interactive "e")
  223.   (let ((click-posn (posn-point (event-start click)))
  224.     ;; Don't let a subsequent kill command append to this one:
  225.     ;; prevent setting this-command to kill-region.
  226.     (this-command this-command))
  227.     (if (and (eq last-command 'local-mouse-save-then-kill)
  228.          mouse-save-then-kill-posn
  229.          (eq (car mouse-save-then-kill-posn) (car kill-ring))
  230.          (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
  231.     ;; If this is the second time we've called
  232.     ;; local-mouse-save-then-kill, delete the text from the buffer.
  233.     (progn
  234.       ;; Delete just one char, so in case buffer is being modified
  235.       ;; for the first time, the undo list records that fact.
  236.       (delete-region (point)
  237.              (+ (point) (if (> (mark) (point)) 1 -1)))
  238.       ;; Now delete the rest of the specified region,
  239.       ;; but don't record it.
  240.       (let ((buffer-undo-list t))
  241.         (delete-region (point) (mark)))
  242.       (if (not (eq buffer-undo-list t))
  243.           (let ((tail buffer-undo-list))
  244.         ;; Search back in buffer-undo-list for the string
  245.         ;; that came from the first delete-region.
  246.         (while (and tail (not (stringp (car (car tail)))))
  247.           (setq tail (cdr tail)))
  248.         ;; Replace it with an entry for the entire deleted text.
  249.         (and tail
  250.              (setcar tail (cons (car kill-ring) (point)))))))
  251.       ;; Otherwise, save this region.
  252.       (mouse-set-mark-fast click)
  253.       (kill-ring-save (point) (mark t))
  254.       (x-set-cut-buffer (buffer-substring (point) (mark)))
  255.       (x-set-selection 'PRIMARY (buffer-substring (point) (mark)))
  256.       (mouse-show-mark)
  257.       (setq mouse-save-then-kill-posn
  258.         (list (car kill-ring) (point) click-posn)))))
  259.   
  260. (provide 'xb-mouse)
  261.